home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-07-15 | 20.8 KB | 772 lines | [TEXT/MPS ] |
- {=============================================================================}
- { SchedulerUnit unit }
- {SchedulerUnit.inc. version 1.1-0E }
- { Copyright © 1989-1991 The NetWork Project, StatLab Heidelberg
- Copyright © 1989-1991 G. Sawitzki, StatLab Heidelberg }
-
- {$SETC debugging=false}
-
- {=============================================================================}
- {Things to do
- Move MyAddr to library and rename
-
- Reduce safety levels. There should be just two flags
- debugging used for low level debugging
- paranoia (foolproof, or some nicer name) Used to add additional checks
- if a user calls a method direcly. Should not be necessary if
- the Scheduler does all the message handling.
-
- Debugger calls should be channelled via HandleError. HandleError needs an
- improvement to make a fail-safe call to the debugger on all platforms/systems.}
- {=============================================================================}
- function MyAddr(var transport:TransportPtr):MsgAddr;
- var tempaddr:MsgAddr;
- begin
- tempAddr:=NetWorkScheduler.MySelf;
- if transport=nil then begin
- transport:=NetWorkScheduler.MyTransport;
- end else tempaddr.a:=Transport^.TransportAddr;
- MyAddr:=tempaddr;
- end;
-
- {$IFC MemberKludge}
- {the member function of MPW 3.2 may run into a bus error instead
- of reporting false when the first argument is not an object. If
- MemberKludge is true, special cautions are taken to avoid this
- problem}
- {dereference and test whether structure starts with a "magic word"}
- function MemberKludge(p: univ handle):boolean;
- type lp=^longint;
- begin
- MemberKludge:=(lp(ord4(p^)+2)^=longint('tMHd'));
- end;
- {$ENDC}
-
-
- {$IFC UNDEFINED UsingEvents}
- {from event -- don't want quickdraw just to get a constant or the time}
- const NetWorkEvt = 10;
- FUNCTION TickCount: LONGINT;
- INLINE $A975;
- {$ENDC}
-
-
- {$IFC UNDEFINED UsingPackages}
- {instead of packages -- we do not want a package just to convert a number}
- procedure numtostring (l : longint; var s : str15);
- var k : longint;
- minus : boolean; { to be done }
- begin
- if l=0 then s:='0' else begin
- s := '';
- if l<0 then begin minus:=true; l:=-l end else minus:=false;
- while (l > 0) do begin
- k := l div 10;
- l := l - k * 10;
- insert (' ',s,1); s [1] := chr (l+ord ('0'));
- l := k;
- end;
- if minus then insert ('-',s,1);
- end;
- { while length (s) < 8 do insert (' ', s, 1);}
- end;
- {$ENDC}
-
-
- {=============================================================================}
- { Default task handler }
-
- procedure tMessageHandler.init;
- begin
- {$IFC MemberKludge}
- MemberKludgeMagic:=longint('tMHd');
- {$IFC paranoia}
- if longint(@MemberKludgeMagic)-longint(handle(self)^)<>2 then ProgramBreak('object header size <>2');
- {$ENDC}
- {$ENDC}
-
- NrPendingMessages:=0;
- restart;
- end;
-
- procedure tMessageHandler.restart;
- begin
- contextstamp:=0;
- end;
-
- procedure tMessageHandler.Stamp(Msg:MsgPtr);
- {should be called only from MsgHeaderUsable (receiver's side)
- or from NewTask (generator's side). Should be called only once per message.}
- begin
- with msg^ do if MsgUserRefCon<>longint(self) then {not yet stamped}
- begin
- {$IFC paranoia} if MsgUserRefCon<>longint(nil) then ProgramBreak('Stamp: got Msg with ref');{should not happen}
- {$ENDC}
-
- NrPendingMessages:=NrPendingMessages+1;
- Msg^.MsgUserRefCon:=longint(self);
- end;
- end;
-
- function tMessageHandler.Destroy(var Msg:MsgPtr):OsErr;
- begin
- Destroy:=NoErr; {still to decide: which error handling should be generic ?}
- if Msg<>nil then
- begin
- if Msg^.MsgUserRefCon=longint(self) then
- begin
- Destroy:=DestroyMsg(Msg);
- NrPendingMessages:=NrPendingMessages-1;
- Msg:=nil;
- end
- {$IFC paranoia}else ProgramBreak('tMessageHandler.Destroy: not my message') {$ENDC};
- end
- {$IFC paranoia} else ProgramBreak('tMessageHandler.Destroy(nil)') {$ENDC};{Msg<>nil }
- end;
-
- procedure tMessageHandler.DisposPrioPtr(var PrioPtr:UNIV Ptr);
- begin
- if PrioPtr<>nil then begin {still to decide: check here ?}
- DisposPtr(PrioPtr);
- PrioPtr:=nil;
- end;
- end;
-
- procedure tMessageHandler.DisposCorePtr(var CorePtr:UNIV Ptr);
- begin
- if CorePtr<>nil then begin {still to decide: check here ?}
- DisposPtr(CorePtr);
- CorePtr:=nil;
- end;
- end;
-
- function tMessageHandler.DisposMsg(var Msg:MsgPtr):OsErr;
- {Should release all buffers associated with Msg,
- and call Destroy}
- var tempMsg:MsgRec;
- begin
- {override by releasing buffers first, if appropriate}
- DisposMsg:=NoErr;
- if Msg<>nil then begin
- tempMsg:= Msg^;
- DisposMsg:=Destroy(Msg);{make sure that the buffers are not accessed any more}
- with tempMsg do begin
- if MsgPrioPtr<>nil then DisposPrioPtr(MsgPrioPtr);
- if MsgCorePtr<>nil then DisposCorePtr(MsgCorePtr);
- end;
- end
- {$IFC debugging} else debugstr('tMessageHandler.DisposeMsg(nil)'){$ENDC};{Msg<>nil }
-
- end;
-
-
- function tMessageHandler.NewPrioPtr(var PrioSize:longint):ptr;
- {Allocate a new buffer for priority data.
- Entry: PrioSize=Requested size;
- Exit: PrioSize=Allocated size;}
- var p:ptr;
- begin
- if PrioSize=0 then NewPrioPtr:=nil
- else begin
- p:=NewPtr(Priosize);
- if p=nil then PrioSize:=0;
- NewPrioPtr:=p;
- end;
- end;
-
- function tMessageHandler.NewCorePtr(var CoreSize:longint):ptr;
- {Allocate a new buffer for core=Core data.
- Entry: PrioSize=Requested size;
- Exit: PrioSize=Allocated size;}
- var p:ptr;
- begin
- if CoreSize=0 then NewCorePtr:=nil
- else begin
- p:=NewPtr(CoreSize);
- if p=nil then CoreSize:=0;
- NewCorePtr:=p;
- end;
- end;
-
- {=============================================================================}
- { prototype message handlers. receiving part }
-
-
- {--------- This function sometimes will be customized ---------}
-
- function tTaskHandler.MsgHeaderUsable(var msg:MsgPtr):boolean;
- {do a pre-check of an incoming message.}
- var MasterOk,ContextOk:boolean;
- tempPrivilegedAddr: MsgAddr;
- begin
-
- {$ifc debugging} if spare then debugstr('tTaskHandler.MsgHeaderusable check context;g'); {$endc}
- ContextOk:=(ContextStamp=0) | (msg^.MsgReference=contextstamp);
-
- tempPrivilegedAddr:=PrivilegedAddr;{avoid $H-}
- MasterOk:=(PrivilegedTimeout = 0) | (EqAddr(msg^.MsgSource,tempPrivilegedAddr));
-
-
- If (PrivilegedTimeout <> 0) & MasterOk then
- PrivilegedTimeout:=tickCount+PrivilegedInterval;
-
- if (not MasterOk) & (PrivilegedTimeout<TickCount) then begin
- PrivilegedTimeout:=0;
- MasterOk:=true;
- {reset context, if context was master dependent.}
- end;
-
- MsgHeaderUsable:=ContextOk&MasterOk;
-
- end;
-
-
- {--------- These function generally will be customized ---------}
- function tTaskHandler.MsgUsable(var msg:MsgPtr): boolean;
- begin
- MsgUsable:=true;
- end;
-
-
- {--------- This function must be customized -------------------------}
- {Keep in mind to call WaitNextEvent regularly if the message evaluation
- takes time.}
-
- procedure tTaskHandler.MsgEvaluation(var msg:MsgPtr);
- begin
-
- end;
-
-
- {prototype message handlers. receiving part}
-
- procedure tTaskHandler.init;
- const
- cPrivilegedInterval=60; {ticks before feeling free for a new partner}
- begin
- inherited init; {will call restart}
- PrivilegedInterval :=cPrivilegedInterval;
- end;
-
- procedure tTaskHandler.restart;
- begin
- inherited restart;
- ContextStamp:=0;
- PrivilegedTimeout:=0; {now}
- with PrivilegedAddr do
- begin a:=0;p:=longint('????'); end; {local, anonymous}
- UsableCapas:=cAnyCapas;
- end;
-
-
-
- {=============================================================================}
- { prototype message handlers. sending part }
-
- procedure tTaskGenerator.init;
- const
- cTickleInterval=60; {ticks before trying a new partner. set by needsattention}
- cWaitInterval=30; {min interval between tasks, in ticks. set by newtask}
- begin
-
- {$IFC debugging} if spare then debugstr('start tTaskGenerator.init;g'); {$ENDC}
-
- inherited init;
- TickleInterval:=cTickleInterval;
- Waitinterval:=cWaitInterval;
- end;
-
- procedure tTaskGenerator.restart;
- begin
- {$IFC debugging} if spare then debugstr('start tTaskGenerator.start;g'); {$ENDC}
- inherited restart;
- contextstamp:=TimeStamp;
- end;
-
- procedure tTaskGenerator.Stamp(Msg:MsgPtr);
- begin
- inherited Stamp(Msg);
- Msg^.MsgReference:=ContextStamp;
- end;
-
- function tTaskGenerator.NewTask(var Msg:MsgPtr):boolean;
- begin
- if Msg<>nil then {set all task generator specific defaults}
- with Msg^ do begin
-
- MsgCapasVerb:=DefaultCapasVerb;
- MsgReference:=ContextStamp;
- {$IFC paranoia} {scheduler sets all fields to zero}
- MsgUserRefCon:=longint(nil);
- MsgPrioSize:=0;
- MsgCoreSize:=0;
- MsgPrioPtr:=nil;
- MsgCorePtr:=nil;
- {$ENDC}
- end;
- NewTask:=false; {but mark as useless so far}
- end;
-
-
- {=============================================================================}
-
- {Scheduler implementation}
-
- procedure tScheduler.sendmessage(msg:MessagePtr);
- {send the message indicated by msg. could be replaced by a direct call to
- the message system. is kept here only for easier tracing.}
- var newMsg:MsgPtr;
- var s:str255;
- begin
- {$IFC debugging} if spare then begin MsgToString(msg,s);debugstr(concat('tScheduler.sendmessage ',s));end; {$ENDC}
- with msg^ do begin
- PrevDest:=msgDest;
- msgSource:=MyAddr(MsgTrpPtr){MySelf; }{••• should go to msg system}
- end;
- HandleError(pSendMessage,SendMsg(msg,newmsg));
- end;
-
- procedure tScheduler.replymessage(msg:MessagePtr;flagsToAdd:longint);
- {send the message indicated by msg, but to msg
- target}
-
- var
- tempMsg:MsgRec;
- newmsg:MsgPtr;
- ttrick:record
- case boolean of
- true:(a,b:integer);
- false:(l:longint)
- end;
- tempstr:str255;
- begin
- tempMsg:=msg^; {needed: MsgReference, MsgTrpPtr,… still to specify}
- with tempmsg do
- begin
- MsgDest:=MsgReply;
- {MsgReply:=MySelf; -- no complaints &results should keep at reply addr.
- still to discuss: pipeline versus master-slaves}
- MsgCapasVerb:=bor(bor(MsgCapasVerb,cMsgReply),flagsToAdd);
- end;
- {$IFC false}
- msgToString(@tempMsg,tempstr);
- logstrtime(concat('reply ',tempstr));
- {$ENDC}
- with tempMsg do begin
- msgSource:=MyAddr(MsgTrpPtr); {••• should go to msg system}
- end;
- {$IFC debugging} if spare then begin MsgToString(msg,s);debugstr(concat('tScheduler.replymessage ',s));end; {$ENDC}
-
- HandleError(pReplyMessage,SendMsg(@tempMsg,newmsg));
- end;
-
- procedure tScheduler.init;
- var tempstr:str255;tempaddr:MsgAddr;
- begin
- {$IFC debugging} if spare then debugstr('start tScheduler.init;g'); {$ENDC}
-
- mySelf:=GetNetWorkAddr;
- MyTransport:=nil;
-
- tempAddr:=MySelf;
- addrToString(tempAddr,tempstr);
- logstring(concat('tScheduler.init ',tempstr));
-
- TaskHandler:=nil;
- TaskGenerator:=nil;
- CoHandler:=Nil;
-
- ErrQuiet:=true;
- Err:=NoErr;
- reset;
-
- {this should be done only on send}
- if Master then if Err=NoErr then HandleError(pInit,NlStart);
- ErrQuiet:=false;
- end;
-
- procedure tScheduler.reset;
- begin
- {$IFC debugging} if spare then debugstr('start tScheduler.reset;sc;g'); {$ENDC}
-
- {if sending then HandleError(pUndefined,nlStop);}
-
- {HandleError(pUndefined,flushMsg); }{??}
-
- sending:=false;
- receiving:=false;
- PrevDest:=MySelf; {will in general only define the type}
- PrevDest.a:=NLNext(PrevDest.a);
- TaskAddr:=MySelf; {??????????}
- if TaskHandler<>nil then TaskHandler.Restart;
- if TaskGenerator<>nil then TaskGenerator.Restart;
- if Cohandler<>nil then CoHandler.Reset;
- Err:=NoErr;
- {HandleError(pUndefined,flushMsg);}{would cancel launch message as well}
- end;
-
- procedure tScheduler.free; override;
- begin
- {$IFC debugging} if spare then debugstr('start tScheduler.free;g');{$ENDC}
- reset;
- if TaskHandler<>nil then TaskHandler.free;
- if TaskGenerator<>nil then TaskGenerator.free;
-
- ErrQuiet:=true; {••• do not report errors on uninstalling. Should we ??}
- inherited free;
- end;
-
- procedure tScheduler.setSending(onoff:boolean);
- begin
- if onOff then begin
- if (TaskHandler<>nil) & (Err=NoErr) then sending:=true
- end
- else sending:=false;
- end;
-
- procedure tScheduler.setReceiving(onoff:boolean);
- begin
- if onOff then begin
- if (TaskGenerator<>nil) & (Err=NoErr) then Receiving:=true
- end
- else Receiving:=false;
- end;
-
- Procedure tScheduler.InitTaskHandler(newTaskHandler:tTaskHandler);
- begin
- {$IFC debugging} if spare then debugstr('start tScheduler.InitTaskHandler;g'); {$ENDC}
- TaskHandler:=newTaskHandler;
- if TaskHandler=nil then HandleError(pUndefined,cNilError)
- else begin
- {set tScheduler proposals, if any}
- TaskHandler.init;
- end;
- Receiving:=(TaskHandler<>nil);
-
- {•••••should clear pending messages.}
- {$IFC debugging} if receiving & spare then debugstr('tScheduler.InitTaskHandler receiving;g'); {$ENDC}
-
- end;
-
-
- Procedure tScheduler.InitTaskGenerator(newTaskGenerator:tTaskGenerator);
- begin
- {$IFC debugging} if spare then debugstr('start tScheduler.initTaskGenerator;g'); {$ENDC}
- {HandleError(pUndefined,nlStart);} {should really go here. But to allow for jump starts…}
- TaskId:=TimeStamp; { a random proposal}
- TaskIterations:=maxint; {we want to do binary search from here}
-
- TaskGenerator:=newTaskGenerator;
- if TaskGenerator=nil then HandleError(pUndefined,cNilError) else
- begin
- with TaskGenerator do {set tScheduler proposals, if any}
- begin
- DefaultCapasVerb:=cAnyCapas;
- end;
- TaskGenerator.init;
- with TaskGenerator do
- begin
- NextTickle:=tickCount+TickleInterval;
- NextWait:=tickCount+WaitInterval;
- end;
- end;
- sending:=(TaskGenerator<>nil);
- {$IFC debugging} if spare then debugstr('stop tScheduler.initTaskGenerator;g');{$ENDC}
- end;
-
- procedure tScheduler.DoNewTask(addr:MsgAddr;Transport:TransportPtr);
- var tempMsgPtr:MsgPtr;
- begin
- tempMsgPtr:=MsgPtr(NewPtrClear(sizeof(MsgRec))); {misuse. we only want a clean variable}
- {is there a proper way to clear a variable, without bothering the memory manager ?
- Fillchar could be misused here, but this would be implementation dependent }
-
- if tempMsgPtr<>nil then begin
- with tempMsgPtr^ do begin {fill in the fields the scheduler knows about}
- MsgSource:=MyAddr(Transport);{MySelf;}
- MsgDest:=addr;
- MsgReply:=MyAddr(Transport);{MySelf;}
- MsgTrpPtr:=Transport;
- end;
- TaskAddr:=addr; {note address for cohandler}
- {***} if CoHandler<>nil then CoHandler.Cohandle(pStartNewTask,tempMsgPtr);
- if TaskGenerator.NewTask(tempMsgPtr) then begin
- PreventIdle; { added 4/15/90 -- Joachim }
- {***} if CoHandler<>nil then CoHandler.Cohandle(pNewTaskDone,tempMsgPtr);
- SendMessage(tempMsgPtr);
- NextWait:=tickCount+TaskGenerator.WaitInterval;{block timer}
- end
- else begin
-
- {***} if CoHandler<>nil then CoHandler.Cohandle(pNoNewTask,tempMsgPtr);
- NextWait:=0;{release timer}
- end;
- DisposPtr(Ptr(tempMsgPtr));
- end;
- end;
-
- {---------------------------------------------------------------}
- { *****************•••••••••••••••••**************** }
-
-
- procedure tScheduler.HandleMsg (Msg : MsgPtr);
- var i : integer; p : Ptr;
- listenSize:longint;listenHandler:tTaskHandler;
- myErr:OsErr;
-
- function killMsg:osErr;
- var s:str255;
- begin
-
- with Msg^ do
- begin
- {$IFC debugging}
- if (ptr(MsgUserRefCon)<>nil) then begin
- MsgToString(msg,s);
- LogString(concat('killmsg ',s));
- debugstr(concat(s,';g'));
- end;
- {$ENDC}
- {$IFC true}
-
- if (ptr(MsgUserRefCon)<>nil) &
- {$IFC MemberKludge}
- MemberKludge(MsgUserRefCon) &
- {$ENDC}
- member(tObject(MsgUserRefCon),tMessageHandler) then begin
-
- killMsg:=tMessageHandler(MsgUserRefCon).DisposMsg(msg) ;
- MsgUserRefCon:=longint(nil);
- end else
- {$ENDC}
- killMsg:= DestroyMsg (Msg);
- end;
-
- end;
-
- function ReceiveMsg:OsErr;
- var buffer : Ptr;
- ReceiveSize:longint;
- begin
- ReceiveSize:=Msg^.MsgCoreSize;
- if ReceiveSize=0 then ReceiveMsg:=AcceptMsg(Msg,Nil,0) else
- begin
- with Msg^ do begin
- buffer:=Msg^.MsgCorePtr; {the taskhandler should have installed it}
- if buffer=nil then {no buffer: try to create it}
- buffer:=tTaskHandler(MsgUserRefCon).NewCorePtr(ReceiveSize);
- end;
-
- if buffer = nil then ReceiveMsg:=cNilError
- else ReceiveMsg:= AcceptMsg (Msg, buffer, ReceiveSize);
- end;
- end; {ReceiveMsg}
-
- begin
- if Msg<>nil then with Msg^ do
- if (MsgResult < 0) | (BAnd (MsgCmd, tMinorMask) >= tTimeout) then
- CheckError('Handle bad msg',killMsg )
- else case BAnd (MsgCmd, tMajorMask) of
- tListen : begin
- {$IFC paranoia}
- if MsgUserRefCon<>longint(nil) then ProgramBreak('handleMsg: got Msg with ref');{should not happen}
- {$ENDC}
- if not TaskHandler.MsgHeaderUsable(Msg) then
- CheckError ('Out of context', killMsg)
- else begin
-
- if MsgUserRefCon=longint(nil) then {no special handler assigned}
- begin
- listenHandler:=taskhandler; {default to scheduler's task handler}
- listenHandler.stamp(msg);
- end
- else
- listenHandler:=tTaskHandler(MsgUserRefCon); {take special handler}
- listenSize:=MsgPrioSize;
- p:= MsgPrioPtr;
- if (p=nil) then p:=listenhandler.NewPrioPtr(listenSize); {fall back solution}
- if (p=nil) & (MsgPrioSize>0) then {in context, no buffer,but existing prio}
- CheckError('Empty Prio Buffer',cNilError)
- else begin
- CheckError('GetMsg',GetMsg(Msg,p,listenSize));
- TaskAddr:=msg^.MsgSource;
- if listenHandler.MsgUsable(msg) then begin
- myErr:=ReceiveMsg;
- {***} if CoHandler<>nil then CoHandler.Cohandle(pUsable,msg);
-
- if myErr<>noErr then
- begin
- CheckError ('Receive',myerr);
- CheckError ('Deny', killMsg);
- end;
- end
-
- else
- begin
- if CoHandler<>nil then CoHandler.Cohandle(pUnUsable,msg);
- CheckError ('Deny', killMsg);
- end;
- end;
- end;
- end;
- tAccept : begin
- tTaskHandler(MsgUserRefCon).MsgEvaluation(Msg);
- CheckError ('Dispos accepted',killMsg);
- end;
- tPost : CheckError ('Posted',KillMsg);
- otherwise ProgramBreak ('tScheduler.HandleMsg:unexpected msgCmd');
- end;
- end;
-
-
- {---------------------------------------------------------------}
- { }
-
- procedure tScheduler.PeriodicTask;
- const timetospend=10;{ticks allowed for receive}
- var
- timeout:longint;
- destinationaddr:MsgAddr;
- TaskGeneratorNeedsAttention:boolean;
- begin
-
- {make sure handlers are installed. needed for Housekeeping ? else later}
- if TaskHandler=nil then receiving:=false;
- if TaskGenerator=nil then sending:=false;
-
- if sending then
- begin
- TaskGeneratorNeedsAttention:=false;
- destinationaddr:=PrevDest;
- if (tickCount>NextTickle) then begin
- {$IFC debugging} if spare then debugstr('TaskGeneratorNeedsAttention;g');{$ENDC}
- NextTickle:=tickCount+TaskGenerator.TickleInterval;
- {NextWait is handled by DoNewTask}
- destinationaddr.a:=NLRandom;
- TaskGeneratorNeedsAttention:=true;
- end else if (tickCount>NextWait) then begin
- destinationaddr.a:=NLNext(destinationaddr.a);
- TaskGeneratorNeedsAttention:=true;
- end;
- if TaskGeneratorNeedsAttention then begin
- DoNewTask(destinationaddr,MyTransport);
- end;
- end;{TaskGeneratorNeedsAttention}
- end;
-
- function tScheduler.GetSleep:longint;
- var tempSleep,now,nexttime:longint;
- begin
- tempSleep := maxlongint; { default: no time required at all }
- now:=tickcount;
- if sending then begin nexttime:=NextWait;if nextTickle<nexttime then nexttime:=nexttickle; end;
- tempSleep:=nexttime-now;
- if tempSleep < 0 then tempSleep := 0;
- GetSleep:=tempsleep;
- end;
-
-
- procedure tscheduler.kickOff(maxcount,maxticks:integer);
- var
- {$IFC debugging}
-
- s,s1:str255;
- oldmaxcount,oldticks:longint;
- {$ENDC}
- timelimit:longint;
- begin
- {$IFC debugging}
- oldmaxcount:=maxcount;
- oldticks:=maxticks;
- {$ENDC}
-
- timelimit:=tickcount+maxticks;
- if maxcount=0 then maxcount:=NLCount;{ we will do at least one}
- repeat
- nextTickle:=0;
- nextWait:=0;
- PeriodicTask;
- maxcount:=maxcount-1;
- until (not (sending | receiving))|(tickcount>timelimit)|(maxcount<=0);
- {$IFC debugging} oldTicks:=tickCount-oldticks; {time done }
- oldmaxcount:=oldmaxcount-maxcount; {counts done}
- if spare then ProgramBreak('tscheduler.kickOff tickle done.;dm a6 '); {$ENDC}
-
- end;
-
- procedure tScheduler.handleError(from:tSchedulerPhase;which:OsErr);
- label 1,9;
- const
- _Unimplemented = $A89F;
- _Debugger = $A9FF;
- _DebugStr = $ABFF;
-
- var s:str255;s1,s2:str15;
- begin
- {filter bogus errors}
- if which <> noerr then
- case from of
- pSendMessage: case which of
- eQueEmpty,{may last until timeout -- note while stage alpha. needs
- less tasks or more message buffers}
- ePrio2Big,
- eSizeLimit,
- eProtType,
- eTransportDown,
- eCmdSequence:;
- otherwise which:=noErr
- end;
- pHousekeepingDestroy,pFree,pAcceptMsg: which:=noErr;
- pinit:;{note all errors}
-
- otherwise
- end;
-
-
- 1: if (which<>noErr)
- & (which<>eInvalid) { for now. network error handling still to be fixed •••}
- then begin
-
- if (not ErrQuiet) & {some debugger installed}
- (NGetTrapAddress (_DebugStr, ToolTrap) <> NGetTrapAddress (_Unimplemented, ToolTrap))
- then {report the error, using the debugger} begin
- numtostring(which,s1);
- numtostring(ord(from),s2);
- s:=concat('tScheduler detected error ',s1,' from ',s2,';sc');
- debugstr(s); {debugger esists}
- if spare then begin debugstr('tScheduler.handleError going to clear error code.');end;{spare handleerror}
-
- end;
- Err:=which;
-
- if spare then begin err:=NoErr;end;{spare handleerror}
-
- ErrFrom:=from;
- end; {Err}
- 9:
- end;
-
-
-
- {=============================================================================}
- { cohandler implementation
- There is no real default implementation for cohandlers. This is just a
- prototype to define the calling conventions.}
-
- procedure tSchedulerCohandler.CoHandle(cmd:tSchedulerPhase;msg:MsgPtr);
- begin
- case cmd of
- pUndefined:;
- pUsable:;
- pUnUsable:;
- pStartNewTask:;
- pNewTaskDone:;
- pNoNewTask:;
- otherwise
- end;
- end;
-
- procedure tSchedulerCohandler.Reset;
- begin
- end;
-